Este trabalho foi desenvolvido como parte da disciplina de Visualização e Relatório de Segmentos e seu principal objetivo é responder as perguntas a seguir:
# Carregando os dados
wine_data <- read.csv("data/wine.data", header = FALSE)
colnames(wine_data) <- c(
"Class",
"Alcohol",
"Malic_acid",
"Ash",
"Alcalinity_ash",
"Magnesium",
"Total_phenols",
"Flavanoids",
"Nonflavanoid_phenols",
"Proanthocyanins",
"Color_intensity",
"Hue",
"OD280_OD315",
"Proline"
)
wine_numeric <- wine_data[, -1]
correlation_matrix <- cor(wine_numeric)
# Matriz de Correlação:
print(round(correlation_matrix, 3))
## Alcohol Malic_acid Ash Alcalinity_ash Magnesium
## Alcohol 1.000 0.094 0.212 -0.310 0.271
## Malic_acid 0.094 1.000 0.164 0.289 -0.055
## Ash 0.212 0.164 1.000 0.443 0.287
## Alcalinity_ash -0.310 0.289 0.443 1.000 -0.083
## Magnesium 0.271 -0.055 0.287 -0.083 1.000
## Total_phenols 0.289 -0.335 0.129 -0.321 0.214
## Flavanoids 0.237 -0.411 0.115 -0.351 0.196
## Nonflavanoid_phenols -0.156 0.293 0.186 0.362 -0.256
## Proanthocyanins 0.137 -0.221 0.010 -0.197 0.236
## Color_intensity 0.546 0.249 0.259 0.019 0.200
## Hue -0.072 -0.561 -0.075 -0.274 0.055
## OD280_OD315 0.072 -0.369 0.004 -0.277 0.066
## Proline 0.644 -0.192 0.224 -0.441 0.393
## Total_phenols Flavanoids Nonflavanoid_phenols
## Alcohol 0.289 0.237 -0.156
## Malic_acid -0.335 -0.411 0.293
## Ash 0.129 0.115 0.186
## Alcalinity_ash -0.321 -0.351 0.362
## Magnesium 0.214 0.196 -0.256
## Total_phenols 1.000 0.865 -0.450
## Flavanoids 0.865 1.000 -0.538
## Nonflavanoid_phenols -0.450 -0.538 1.000
## Proanthocyanins 0.612 0.653 -0.366
## Color_intensity -0.055 -0.172 0.139
## Hue 0.434 0.543 -0.263
## OD280_OD315 0.700 0.787 -0.503
## Proline 0.498 0.494 -0.311
## Proanthocyanins Color_intensity Hue OD280_OD315 Proline
## Alcohol 0.137 0.546 -0.072 0.072 0.644
## Malic_acid -0.221 0.249 -0.561 -0.369 -0.192
## Ash 0.010 0.259 -0.075 0.004 0.224
## Alcalinity_ash -0.197 0.019 -0.274 -0.277 -0.441
## Magnesium 0.236 0.200 0.055 0.066 0.393
## Total_phenols 0.612 -0.055 0.434 0.700 0.498
## Flavanoids 0.653 -0.172 0.543 0.787 0.494
## Nonflavanoid_phenols -0.366 0.139 -0.263 -0.503 -0.311
## Proanthocyanins 1.000 -0.025 0.296 0.519 0.330
## Color_intensity -0.025 1.000 -0.522 -0.429 0.316
## Hue 0.296 -0.522 1.000 0.565 0.236
## OD280_OD315 0.519 -0.429 0.565 1.000 0.313
## Proline 0.330 0.316 0.236 0.313 1.000
corrplot(
correlation_matrix,
method = "color",
type = "upper",
order = "hclust",
tl.cex = 0.8,
tl.col = "black",
tl.srt = 45,
addCoef.col = "black",
number.cex = 0.7,
title = "Correlograma das Variáveis do Vinho",
mar = c(0, 0, 1, 0)
)
high_corr <- which(
abs(correlation_matrix) > 0.7 & correlation_matrix != 1,
arr.ind = TRUE
)
for (i in seq_len(nrow(high_corr))) {
var1 <- rownames(correlation_matrix)[high_corr[i, 1]]
var2 <- colnames(correlation_matrix)[high_corr[i, 2]]
corr_value <- correlation_matrix[high_corr[i, 1], high_corr[i, 2]]
cat(sprintf("%s - %s: %.3f\n", var1, var2, corr_value))
}
## Flavanoids - Total_phenols: 0.865
## Total_phenols - Flavanoids: 0.865
## OD280_OD315 - Flavanoids: 0.787
## Flavanoids - OD280_OD315: 0.787
No correlograma das variáveis do vinho, é possível observar os seguintes pares de variáveis com forte correlação:
wine_scaled <- scale(wine_numeric)
# Aplicando PCA
pca_result <- prcomp(wine_scaled, center = FALSE, scale. = FALSE)
variance_explained <- pca_result$sdev^2
prop_variance <- variance_explained / sum(variance_explained)
cumulative_variance <- cumsum(prop_variance)
pca_summary <- data.frame(
Component = seq_along(prop_variance),
Variance_Explained = round(prop_variance * 100, 2),
Cumulative_Variance = round(cumulative_variance * 100, 2)
)
# Variância explicada por cada componente (%):
print(pca_summary)
## Component Variance_Explained Cumulative_Variance
## 1 1 36.20 36.20
## 2 2 19.21 55.41
## 3 3 11.12 66.53
## 4 4 7.07 73.60
## 5 5 6.56 80.16
## 6 6 4.94 85.10
## 7 7 4.24 89.34
## 8 8 2.68 92.02
## 9 9 2.22 94.24
## 10 10 1.93 96.17
## 11 11 1.74 97.91
## 12 12 1.30 99.20
## 13 13 0.80 100.00
components_70 <- which(cumulative_variance > 0.70)[1]
variance_70 <- round(cumulative_variance[components_70] * 100, 2)
print(
paste(
"Número de componentes necessários para explicar >70% da variância:",
components_70
)
)
## [1] "Número de componentes necessários para explicar >70% da variância: 4"
print(
paste(
"Variância explicada com",
components_70,
"componentes:",
variance_70,
"%"
)
)
## [1] "Variância explicada com 4 componentes: 73.6 %"
# Criando o Scree Plot
scree_data <- data.frame(
Component = seq_len(min(10, length(prop_variance))),
Variance = prop_variance[seq_len(min(10, length(prop_variance)))] * 100,
Cumulative = cumulative_variance[
seq_len(min(10, length(prop_variance)))
] * 100
)
# Scree Plot - Variância Individual
p1 <- ggplot(scree_data, aes(x = Component, y = Variance)) +
geom_line(color = "blue", linewidth = 1) +
geom_point(color = "red", size = 3) +
labs(
title = "Scree Plot - Variância Explicada por Componente",
x = "Componente Principal",
y = "Variância Explicada (%)"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5))
print(p1)
# Gráfico da variância cumulativa
p2 <- ggplot(scree_data, aes(x = Component, y = Cumulative)) +
geom_line(color = "darkgreen", linewidth = 1) +
geom_point(color = "orange", size = 3) +
geom_hline(
yintercept = 70,
linetype = "dashed",
color = "red",
linewidth = 1
) +
geom_vline(
xintercept = components_70,
linetype = "dashed",
color = "red",
linewidth = 1
) +
labs(
title = "Variância Cumulativa Explicada",
x = "Componente Principal",
y = "Variância Cumulativa (%)"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
annotate("text",
x = components_70 + 0.5, y = 50,
label = paste("PC", components_70, "\n70%"),
color = "red", size = 4
)
print(p2)
loadings_matrix <- pca_result$rotation[, 1:components_70]
# Loadings dos primeiros componentes principais:
print(round(loadings_matrix, 3))
## PC1 PC2 PC3 PC4
## Alcohol -0.144 0.484 -0.207 0.018
## Malic_acid 0.245 0.225 0.089 -0.537
## Ash 0.002 0.316 0.626 0.214
## Alcalinity_ash 0.239 -0.011 0.612 -0.061
## Magnesium -0.142 0.300 0.131 0.352
## Total_phenols -0.395 0.065 0.146 -0.198
## Flavanoids -0.423 -0.003 0.151 -0.152
## Nonflavanoid_phenols 0.299 0.029 0.170 0.203
## Proanthocyanins -0.313 0.039 0.149 -0.399
## Color_intensity 0.089 0.530 -0.137 -0.066
## Hue -0.297 -0.279 0.085 0.428
## OD280_OD315 -0.376 -0.164 0.166 -0.184
## Proline -0.287 0.365 -0.127 0.232
# Variáveis mais importantes em cada componente (|loading| > 0.3):
for (i in 1:components_70) {
important_vars <- names(which(abs(loadings_matrix[, i]) > 0.3))
loadings_values <- loadings_matrix[important_vars, i]
component_desc <- paste("PC", i, ":", sep = "")
var_desc <- paste(
important_vars,
"(",
round(loadings_values, 3),
")",
sep = "",
collapse = ", "
)
print(paste(component_desc, var_desc))
}
## [1] "PC1: Total_phenols(-0.395), Flavanoids(-0.423), Proanthocyanins(-0.313), OD280_OD315(-0.376)"
## [1] "PC2: Alcohol(0.484), Ash(0.316), Color_intensity(0.53), Proline(0.365)"
## [1] "PC3: Ash(0.626), Alcalinity_ash(0.612)"
## [1] "PC4: Malic_acid(-0.537), Magnesium(0.352), Proanthocyanins(-0.399), Hue(0.428)"
Quantos componentes são necessários para explicar mais de 70% da variância?
Resposta: 4 componentes principais são necessários para explicar 73.60% da variância total dos dados.
O scree plot mostra claramente a diminuição da variância explicada por cada componente:
A partir do PC5, a contribuição individual de cada componente torna-se muito pequena (< 5%), caracterizando o “cotovelo” típico no scree plot.
PC1 (36.20% da variância) - Total_phenols (-0.395), Flavanoids (-0.423), OD280_OD315 (-0.376), Proanthocyanins (-0.313)
PC2 (19.23% da variância) - Color_intensity (0.530), Alcohol (0.484), Proline (0.365), Ash (0.316)
PC3 (11.61% da variância) - Ash (0.626) e Alcalinity_ash (0.612)
PC4 (6.56% da variância) - Malic_acid (-0.537), Hue (0.428), Proanthocyanins (-0.399), Magnesium (0.352)
Os resultados do PCA confirmam e complementam as correlações encontradas anteriormente:
# Extraindo as 4 primeiras componentes principais (70% da variância)
pca_data <- pca_result$x[, 1:components_70]
print(
paste(
"Dimensões dos dados PCA para clustering:",
paste(dim(pca_data),
collapse = " x "
)
)
)
## [1] "Dimensões dos dados PCA para clustering: 178 x 4"
print(paste("Usando", components_70, "componentes principais"))
## [1] "Usando 4 componentes principais"
# Função para calcular índice de Silhueta para diferentes valores de k
silhouette_analysis <- function(data, k_range = 2:8) {
silhouette_scores <- numeric(length(k_range))
for (i in seq_along(k_range)) {
k <- k_range[i]
set.seed(123) # Para reprodutibilidade
kmeans_result <- kmeans(data, centers = k, nstart = 25)
# Calculando índice de Silhueta
sil <- silhouette(kmeans_result$cluster, dist(data))
silhouette_scores[i] <- mean(sil[, 3])
}
return(data.frame(k = k_range, silhouette = silhouette_scores))
}
# Calculando índices de Silhueta para k de 2 a 8
sil_results <- silhouette_analysis(pca_data, k_range = 2:8)
# Índices de Silhueta por número de clusters:
print(sil_results)
## k silhouette
## 1 2 0.3529381
## 2 3 0.4065969
## 3 4 0.3657029
## 4 5 0.3540027
## 5 6 0.3161115
## 6 7 0.2681640
## 7 8 0.2654251
optimal_k <- sil_results$k[which.max(sil_results$silhouette)]
max_silhouette <- max(sil_results$silhouette)
print(paste("Número ótimo de clusters (k):", optimal_k))
## [1] "Número ótimo de clusters (k): 3"
print(paste("Índice de Silhueta máximo:", round(max_silhouette, 4)))
## [1] "Índice de Silhueta máximo: 0.4066"
p_silhouette <- ggplot(sil_results, aes(x = k, y = silhouette)) +
geom_line(color = "blue", linewidth = 1.2) +
geom_point(color = "red", size = 3) +
geom_point(
data = sil_results[sil_results$k == optimal_k, ],
aes(x = k, y = silhouette),
color = "darkgreen", size = 5, shape = 17
) +
labs(
title = "Análise do Índice de Silhueta para Determinação do K Ótimo",
x = "Número de Clusters (k)",
y = "Índice de Silhueta Médio"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
annotate("text",
x = optimal_k + 0.3, y = max_silhouette - 0.02,
label = paste(
"k =", optimal_k, "\nSilhueta =", round(max_silhouette, 3)
),
color = "darkgreen", size = 4, fontface = "bold"
)
print(p_silhouette)
set.seed(123)
final_kmeans <- kmeans(pca_data, centers = optimal_k, nstart = 25)
# Resultados do K-Médias com k ótimo
print(paste("Número de clusters:", optimal_k))
## [1] "Número de clusters: 3"
# Tamanho dos clusters
print(table(final_kmeans$cluster))
##
## 1 2 3
## 62 51 65
cluster_stats <- data.frame(
Cluster = 1:optimal_k,
Tamanho = as.numeric(table(final_kmeans$cluster)),
Percentual = round(
as.numeric(table(final_kmeans$cluster)) / nrow(pca_data) * 100, 1
)
)
# Distribuição dos clusters
print(cluster_stats)
## Cluster Tamanho Percentual
## 1 1 62 34.8
## 2 2 51 28.7
## 3 3 65 36.5
# Adicionando informação dos clusters aos dados originais
wine_data_clustered <- wine_data
wine_data_clustered$Cluster_PCA <- final_kmeans$cluster
# Comparando com as classes originais
comparison_table <- table(
wine_data_clustered$Class, wine_data_clustered$Cluster_PCA
)
print(comparison_table)
##
## 1 2 3
## 1 0 0 59
## 2 62 3 6
## 3 0 48 0
# Calculando pureza dos clusters
cluster_purity <- function(clusters, classes) {
confusion_matrix <- table(classes, clusters)
sum(apply(confusion_matrix, 2, max)) / sum(confusion_matrix)
}
purity <- cluster_purity(final_kmeans$cluster, wine_data$Class)
print(paste("Pureza dos clusters:", round(purity, 4)))
## [1] "Pureza dos clusters: 0.9494"
# Visualização dos clusters nas duas primeiras componentes principais
cluster_viz_data <- data.frame(
PC1 = pca_data[, 1],
PC2 = pca_data[, 2],
Cluster = as.factor(final_kmeans$cluster),
Class_Original = as.factor(wine_data$Class)
)
# Gráfico dos clusters PCA
p_clusters <- ggplot(cluster_viz_data, aes(x = PC1, y = PC2, color = Cluster)) +
geom_point(size = 3, alpha = 0.7) +
stat_ellipse(level = 0.68, linewidth = 1) +
labs(
title = "Clusters K-Médias nas Componentes Principais",
x = "PC1 (36.20% da variância)",
y = "PC2 (19.23% da variância)",
color = "Cluster"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
scale_color_brewer(type = "qual", palette = "Set1")
print(p_clusters)
# Gráfico das classes originais para comparação
p_original <- ggplot(
cluster_viz_data,
aes(x = PC1, y = PC2, color = Class_Original)
) +
geom_point(size = 3, alpha = 0.7) +
stat_ellipse(level = 0.68, linewidth = 1) +
labs(
title = "Classes Originais nas Componentes Principais",
x = "PC1 (36.20% da variância)",
y = "PC2 (19.23% da variância)",
color = "Classe Original"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
scale_color_brewer(type = "qual", palette = "Set2")
print(p_original)
# Análise das características dos clusters
centroids_pca <- final_kmeans$centers
rownames(centroids_pca) <- paste("Cluster", 1:optimal_k)
print(round(centroids_pca, 3))
## PC1 PC2 PC3 PC4
## Cluster 1 0.127 -1.795 0.237 -0.102
## Cluster 2 2.712 1.122 -0.238 -0.062
## Cluster 3 -2.249 0.831 -0.039 0.147
Método utilizado: Índice de Silhueta para k variando de 2 a 8 clusters.
Resultado: O número ótimo de clusters é k = 3, com índice de Silhueta de 0.274.
O gráfico do índice de Silhueta mostra que:
A escolha de k = 3 é também coerente com o conhecimento do domínio, já que os dados originais possuem 3 classes de vinho.
Distribuição dos clusters: - Os 3 clusters apresentam tamanhos balanceados - Boa separação no espaço das componentes principais - Alta correspondência com as classes originais dos vinhos
Cluster 1: Caracterizado por valores altos em PC1 (componente fenólico) Cluster 2: Valores intermediários em PC1 e PC2 Cluster 3: Valores baixos em PC1, altos em PC2 (intensidade e álcool)
A pureza dos clusters em relação às classes originais demonstra que o algoritmo K-Médias, aplicado nas componentes principais, conseguiu recuperar efetivamente a estrutura natural dos dados, validando tanto a eficácia da redução de dimensionalidade via PCA quanto a qualidade do clustering.
raw_data <- wine_numeric
# Escolha arbitrária de k=4 clusters (sem figura de mérito)
k_arbitrary <- 4
kmeans_raw <- kmeans(raw_data, centers = k_arbitrary, nstart = 25)
# Resultados do K-Médias sem pré-processamento
# Tamanho dos clusters:
print(table(kmeans_raw$cluster))
##
## 1 2 3 4
## 32 23 66 57
cluster_stats_raw <- data.frame(
Cluster = 1:k_arbitrary,
Tamanho = as.numeric(table(kmeans_raw$cluster)),
Percentual = round(
as.numeric(table(kmeans_raw$cluster)) / nrow(raw_data) * 100, 1
)
)
# Distribuição dos clusters (dados originais):
print(cluster_stats_raw)
## Cluster Tamanho Percentual
## 1 1 32 18.0
## 2 2 23 12.9
## 3 3 66 37.1
## 4 4 57 32.0
comparison_raw <- table(wine_data$Class, kmeans_raw$cluster)
print(comparison_raw)
##
## 1 2 3 4
## 1 27 23 0 9
## 2 4 0 49 18
## 3 1 0 17 30
purity_raw <- cluster_purity(kmeans_raw$cluster, wine_data$Class)
print(
paste("Pureza dos clusters (sem pré-processamento):", round(purity_raw, 4))
)
## [1] "Pureza dos clusters (sem pré-processamento): 0.7247"
# Visualização usando as duas variáveis com maior variância
var_importance <- apply(raw_data, 2, var)
top_vars <- names(sort(var_importance, decreasing = TRUE)[1:2])
print(paste(
"Variáveis com maior variância para visualização:",
paste(top_vars, collapse = " e ")
))
## [1] "Variáveis com maior variância para visualização: Proline e Magnesium"
viz_data_raw <- data.frame(
Var1 = raw_data[, top_vars[1]],
Var2 = raw_data[, top_vars[2]],
Cluster_Raw = as.factor(kmeans_raw$cluster),
Class_Original = as.factor(wine_data$Class)
)
p_raw_clusters <- ggplot(
viz_data_raw, aes(x = Var1, y = Var2, color = Cluster_Raw)
) +
geom_point(size = 3, alpha = 0.7) +
labs(
title = "Clusters sem Pré-processamento (Dados Originais)",
x = top_vars[1],
y = top_vars[2],
color = "Cluster"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5)) +
scale_color_brewer(type = "qual", palette = "Dark2")
print(p_raw_clusters)
# Centróides dos clusters (dados originais):
centroids_raw <- kmeans_raw$centers
rownames(centroids_raw) <- paste("Cluster", 1:k_arbitrary)
print(round(centroids_raw, 2))
## Alcohol Malic_acid Ash Alcalinity_ash Magnesium Total_phenols
## Cluster 1 13.53 1.93 2.37 17.72 106.50 2.72
## Cluster 2 13.86 1.79 2.51 17.07 106.00 2.94
## Cluster 3 12.50 2.44 2.28 20.78 92.47 2.07
## Cluster 4 12.93 2.66 2.40 19.98 101.84 2.05
## Flavanoids Nonflavanoid_phenols Proanthocyanins Color_intensity Hue
## Cluster 1 2.74 0.29 1.88 4.99 1.04
## Cluster 2 3.11 0.30 1.93 6.26 1.10
## Cluster 3 1.80 0.38 1.47 4.07 0.95
## Cluster 4 1.46 0.40 1.43 5.75 0.87
## OD280_OD315 Proline
## Cluster 1 3.09 1017.44
## Cluster 2 3.04 1338.57
## Cluster 3 2.50 452.55
## Cluster 4 2.30 697.09
# Soma dos quadrados intra-cluster (WCSS)
print(paste("Dados originais:", round(kmeans_raw$tot.withinss, 2)))
## [1] "Dados originais: 1331903.06"
print(paste("Dados com PCA:", round(final_kmeans$tot.withinss, 2)))
## [1] "Dados com PCA: 670.84"
# Comparação direta entre os dois métodos
comparison_summary <- data.frame(
Método = c("Com PCA + Silhueta", "Sem Pré-processamento"),
Num_Clusters = c(optimal_k, k_arbitrary),
Pureza = c(round(purity, 4), round(purity_raw, 4)),
WCSS = c(
round(final_kmeans$tot.withinss, 2), round(kmeans_raw$tot.withinss, 2)
)
)
# Resumo comparativo
print(comparison_summary)
## Método Num_Clusters Pureza WCSS
## 1 Com PCA + Silhueta 3 0.9494 670.84
## 2 Sem Pré-processamento 4 0.7247 1331903.06
# Método COM pré-processamento (PCA + Silhueta)
pca_distribution <- as.data.frame.matrix(
table(wine_data$Class, final_kmeans$cluster)
)
names(pca_distribution) <- paste("Cluster", 1:optimal_k)
print(pca_distribution)
## Cluster 1 Cluster 2 Cluster 3
## 1 0 0 59
## 2 62 3 6
## 3 0 48 0
# Método SEM pré-processamento:
raw_distribution <- as.data.frame.matrix(
table(wine_data$Class, kmeans_raw$cluster)
)
names(raw_distribution) <- paste("Cluster", 1:k_arbitrary)
print(raw_distribution)
## Cluster 1 Cluster 2 Cluster 3 Cluster 4
## 1 27 23 0 9
## 2 4 0 49 18
## 3 1 0 17 30
# Visualização comparativa
viz_comparison <- data.frame(
PC1 = pca_data[, 1],
PC2 = pca_data[, 2],
Var1 = raw_data[, top_vars[1]],
Var2 = raw_data[, top_vars[2]],
Cluster_PCA = as.factor(final_kmeans$cluster),
Cluster_Raw = as.factor(kmeans_raw$cluster),
Class_Original = as.factor(wine_data$Class)
)
# Gráfico comparativo - PCA
p_comparison_pca <- ggplot(
viz_comparison, aes(x = PC1, y = PC2, color = Cluster_PCA)
) +
geom_point(size = 2.5, alpha = 0.8) +
stat_ellipse(level = 0.68, linewidth = 1) +
labs(
title = "COM Pré-processamento (PCA + Silhueta)",
x = "PC1 (36.20%)",
y = "PC2 (19.23%)",
color = "Cluster"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 12)) +
scale_color_brewer(type = "qual", palette = "Set1")
# Gráfico comparativo - Dados originais
p_comparison_raw <- ggplot(
viz_comparison, aes(x = Var1, y = Var2, color = Cluster_Raw)
) +
geom_point(size = 2.5, alpha = 0.8) +
stat_ellipse(level = 0.68, linewidth = 1) +
labs(
title = "SEM Pré-processamento (Dados Originais)",
x = top_vars[1],
y = top_vars[2],
color = "Cluster"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 12)) +
scale_color_brewer(type = "qual", palette = "Dark2")
print(p_comparison_pca)
print(p_comparison_raw)
# Análise da dominância de variáveis nos dados originais
var_ranges <- apply(raw_data, 2, function(x) max(x) - min(x))
var_means <- apply(raw_data, 2, mean)
dominant_vars <- data.frame(
Variavel = names(var_ranges),
Amplitude = round(var_ranges, 2),
Media = round(var_means, 2),
Coef_Variacao = round(var_ranges / var_means, 2)
)
dominant_vars <- dominant_vars[
order(dominant_vars$Amplitude, decreasing = TRUE),
]
# Variáveis ordenadas por amplitude (influência no clustering)
print(head(dominant_vars, 5))
## Variavel Amplitude Media Coef_Variacao
## Proline Proline 1402.00 746.89 1.88
## Magnesium Magnesium 92.00 99.74 0.92
## Alcalinity_ash Alcalinity_ash 19.40 19.49 1.00
## Color_intensity Color_intensity 11.72 5.06 2.32
## Malic_acid Malic_acid 5.06 2.34 2.17
Com Pré-processamento (PCA + Silhueta): - Pureza: Maior correspondência com as classes originais - Separação: Clusters bem definidos no espaço das componentes principais - Balanceamento: Distribuição mais equilibrada entre os clusters
Sem Pré-processamento: - Pureza: Menor correspondência com as classes reais - Dominância de variáveis: Clustering influenciado pelas variáveis com maior escala - Desbalanceamento: Possível formação de clusters muito desiguais
Com PCA: - Redução de ruído: Componentes principais capturam a variância mais importante - Visualização clara: Separação evidente no espaço bidimensional PC1 vs PC2 - Significado químico: Componentes relacionam-se com grupos de características químicas
Sem PCA: - Complexidade: 13 dimensões dificultam a interpretação - Escala: Variáveis como Proline (alta amplitude) dominam o clustering - Ruído: Informações menos relevantes podem mascarar padrões importantes
Com Silhueta: - Justificativa objetiva: k=3 baseado em métrica de qualidade - Reprodutibilidade: Critério claro e replicável - Validação: Coerência com o conhecimento do domínio (3 tipos de vinho)
Sem Figura de Mérito: - Escolha arbitrária: k=4 sem justificativa técnica - Subjetividade: Dependente da intuição do analista - Risco: Pode não refletir a estrutura real dos dados
O uso de PCA + normalização + índice de Silhueta não apenas melhorou a qualidade técnica do clustering, mas também proporcionou maior compreensão do problema, revelando a estrutura química subjacente dos vinhos e validando cientificamente os agrupamentos encontrados. A abordagem sem pré-processamento, embora mais simples, produziu resultados menos interpretáveis e potencialmente enviesados pelas escalas das variáveis originais.
VS Code com R
Versão do pacote rmarkdown
Versão do pacote factoextra e FactoMineR
Tableau Public